home *** CD-ROM | disk | FTP | other *** search
/ Complete Linux / Complete Linux.iso / docs / devel / tcl / tclx7_31.z / tclx7_31 / tcldev / tclX7.3a-p1 / tclsrc / pushd.tcl < prev    next >
Encoding:
Text File  |  1993-11-19  |  1.4 KB  |  54 lines
  1. #
  2. # pushd.tcl --
  3. #
  4. # C-shell style directory stack procs.
  5. #
  6. #------------------------------------------------------------------------------
  7. # Copyright 1992-1993 Karl Lehenbauer and Mark Diekhans.
  8. #
  9. # Permission to use, copy, modify, and distribute this software and its
  10. # documentation for any purpose and without fee is hereby granted, provided
  11. # that the above copyright notice appear in all copies.  Karl Lehenbauer and
  12. # Mark Diekhans make no representations about the suitability of this
  13. # software for any purpose.  It is provided "as is" without express or
  14. # implied warranty.
  15. #------------------------------------------------------------------------------
  16. # $Id: pushd.tcl,v 3.0 1993/11/19 07:00:32 markd Rel $
  17. #------------------------------------------------------------------------------
  18. #
  19.  
  20. #@package: TclX-directory_stack pushd popd dirs
  21.  
  22. global TCLXENV(dirPushList)
  23.  
  24. set TCLXENV(dirPushList) ""
  25.  
  26. proc pushd {args} {
  27.     global TCLXENV
  28.  
  29.     if {[llength $args] > 1} {
  30.         error "bad # args: pushd [dir_to_cd_to]"
  31.     }
  32.     set TCLXENV(dirPushList) [linsert $TCLXENV(dirPushList) 0 [pwd]]
  33.  
  34.     if {[llength $args] != 0} {
  35.         cd [glob $args]
  36.     }
  37. }
  38.  
  39. proc popd {} {
  40.     global TCLXENV
  41.  
  42.     if [llength $TCLXENV(dirPushList)] {
  43.         cd [lvarpop TCLXENV(dirPushList)]
  44.         pwd
  45.     } else {
  46.         error "directory stack empty"
  47.     }
  48. }
  49.  
  50. proc dirs {} { 
  51.     global TCLXENV
  52.     echo [pwd] $TCLXENV(dirPushList)
  53. }
  54.